home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_d / isamexpt.zip / UUSEISAM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-13  |  30KB  |  1,106 lines
  1. {$x+}
  2.  
  3. { Useisam.Pas   Rev 01.0 vom  9. Juni   89: Isam 3.0 , Turbo 4.0
  4.                 Rev 02.0 vom 24. April  91: Isam 5.21, Turbo 6.0
  5.                 Rev 03.0 vom 26. Mai    92: Isam 5.3 , Turbo 6.0
  6.                 Rev 04.0 vom  3. Januar 93: Isam 5.4 , BP 7.0
  7.                 Rev 05.0 vom 22. August 95: Filer 5.5, Delphi
  8.   Inhalt: Routinen zur Unterstⁿtzung der Netisam
  9. }
  10. unit Uuseisam;
  11.  
  12.  
  13. interface
  14.  
  15.  
  16. USES Filer, UToolDll, isamtool;
  17.  
  18. procedure DIEE;
  19. Procedure DIE;
  20. function  IA:boolean; {Testet, ob Dialog-Meldung vorliegt und löscht sie}
  21. function NotFound:boolean; {Testet, ob bei letzter Op. "nicht gef." herauskam}
  22.  
  23. const Isamwsnr : Longint = 1;
  24.       MySAVE   : Boolean = FALSE;
  25.  
  26. var
  27.   SatzNoAngel : longint;
  28.   IsamFehler  : Integer Absolute IsamError;
  29.   InitCount   : Integer;
  30.  
  31.  
  32.  
  33. type
  34.   KeyProc    = Function ( Var DSatz; KeyNr : Word ) : IsamKeyStr;
  35.   ChangeProc = Function(var DatOld,DatNew;Len:word):boolean;
  36.  
  37. PROCEDURE EXITIsam;
  38. Function INITIsam(Netz:NetSupportType) : Boolean;
  39.  
  40.  
  41. PROCEDURE CLEARKEY(VAR IFBPtr : ISAMFILEBLOCKPTR;KEY: INTEGER);
  42. {Setzt den Datensatzzeiger auf den 1. Schlüssel von Key
  43.  
  44.   IFBPtr  : Dateivariable
  45.   Key     : Keynummer
  46. }
  47.  
  48. PROCEDURE READLOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  49. {Setzt ein READLOCK auf die Datei
  50.  
  51.   IFBPtr  : Dateivariable
  52. }
  53. PROCEDURE LOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  54. {Setzt ein LOCK auf die Datei
  55.  
  56.   IFBPtr  : Dateivariable
  57. }
  58. PROCEDURE UNLOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  59. {Hebt den READLOCK auf
  60.  
  61.   IFBPtr  : Dateivariable
  62. }
  63.  
  64.  
  65. procedure SatzLesen (Var IFBPtr : IsamFileBlockPtr;RefNr:longint;
  66.                      var Ziel,Dup);
  67. {Liest einen Satz aus der angegebenen Isam-Datei.
  68.  
  69.   IFBPtr  : Dateivariable
  70.   RefNr   : Datensatznummer des zu lesenden Satzes
  71.   Ziel    : Variable, in der der Satz gespeichert werden soll
  72.   Dup     : muß vom selben Typ wie Ziel sein. Wird von den Schreibprozeduren
  73.             verwendet, um festzustellen, ob der Satz inzwischen verändert
  74.             wurde. Darf daher nicht von Hand verändert werden.
  75.  
  76.   Bitte anschließend IsamOK beachten.
  77.   Fehlermöglichkeiten: wie bei GetNetRec.
  78. }
  79.  
  80. procedure SatzAendern(Var IFBPtr:IsamFileBlockPtr;RefNr:longint;
  81.                       Var Quelle,Dup;Keys:KeyProc;var OK:boolean);
  82. {Schreibt einen geänderten Satz zurück in die Isam-Datei.
  83.  
  84.   IFBPtr  : Dateivariable
  85.   RefNr   : Datensatznummer des zurückzuschreibenden Satzes
  86.   Quelle  : zu schreibender Satz
  87.   Dup     : muß das von SatzLesen erzeugte Duplikat des alten Satzes enthalten
  88.   Keys    : Zeiger auf eine Funktion, die die Datensatzschlüssel ermittelt.
  89.             (s. Anmerkungen zu "type KeyProc" weiter oben.)
  90.   OK      : enthält OK nach der Ausführung FALSE, so konnte nicht geschrieben
  91.             werden, weil der Satz inzwischen verändert wurde oder weil das Än-
  92.             dern einen doppelten Hauptschlüssel zur Folge hätte.
  93.  
  94.   Bitte anschließend IsamOk und OK beachten.
  95.   Fehlermöglichkeiten: wie bei LockFileBlock, GetNetRec, PutNetRec,
  96.   DeleteKey, AddKey, UnlockFile sowie siehe OK.
  97.  
  98. }
  99.  
  100. procedure SatzAnlegen(Var IFBPtr:IsamFileBlockPtr;
  101.                      var Quelle;Keys:KeyProc);
  102. {Legt einen Satz an.
  103.  
  104.   IFBPtr  : Dateivariable
  105.   Quelle  : zu schreibender Satz
  106.   Keys    : s. SatzAendern, type KeyProc
  107.  
  108.   Bitte anschließend IsamOK beachten.
  109.   Fehlermöglichkeiten: wie bei LockFileBlock, AddNetRec, AddKey,
  110.   UnlockFile.
  111.  
  112. }
  113.  
  114.  
  115. procedure Satzloeschen(Var IFBPtr:IsamFileBlockPtr;RefNr:longint;
  116.                        var Dup;Keys:KeyProc;var OK:boolean);
  117. {Löscht einen Satz.
  118.  
  119.   IFBPtr  : Dateivariable
  120.   RefNr   : Nummer des zu löschenden Satzes
  121.   Dup     : s. SatzAendern
  122.   Keys    : s. SatzAendern, type KeyProc
  123.   OK      : s. SatzAendern
  124.  
  125.   Bitte anschließend IsamOk beachten.
  126.   Fehlermöglichkeiten: s. SatzAendern
  127. }
  128.  
  129. procedure DateiOeffnen (var IFBPtr:IsamFileBlockPtr;Name:String;Save:boolean;
  130.           RSize:longint);
  131. {Öffnet einen Fileblock.
  132.  
  133.   IFBPtr  : Dateivariable
  134.   Name    : Pfad+Vorname der Datei
  135.   Save    : TRUE, wenn im Savemodus geöffnet werden soll
  136.   RSize   : Datensatzrecordgröße. Dient der Kontrolle, ob Programm- und
  137.             Dateiversion kompatibel sind.
  138.  
  139.   Bitte anschließend IsamOk beachten.
  140.   Fehlermöglichkeiten wie Open(Save)NetFileBlock.
  141. }
  142.  
  143. procedure DateiSchliessen (var IFBPtr:IsamFileBlockPtr);
  144. {Schließt einen Fileblock.
  145.  
  146.   IFBPtr  : Dateivariable
  147.  
  148.   Bitte anschließend IsamOk beachten.
  149.   Fehlermöglichkeiten wie bei CloseNetFileBlock.
  150. }
  151.  
  152. procedure KeySuchen (var IFBPtr:IsamFileBlockPtr;Key:integer;
  153.                      var Userdatref:Longint;var Userkey:IsamKeyStr;
  154.                      var Found:boolean);
  155. {Sucht einen Schlüssel.
  156.  
  157.   IFBPtr  : Dateivariable
  158.   Key     : Schlüsselnummer
  159.   UserdatRef : erhält die Datensatznummer des gefundenen Schlüssels
  160.   UserKey : zu suchender Schlüssel
  161.   Found   : TRUE:  gewünschter Schlüssel wurde gefunden.
  162.             FALSE: gewünschter Schlüssel wurde nicht gefunden, weil
  163.               IsamOK=TRUE:  er nicht existiert. Userkey enthält den nächsten
  164.                             größeren Schlüssel.
  165.               IsamOK=FALSE: der Zugriff wegen eines Fehlers nicht durchge-
  166.                             führt werden konnte.
  167.  
  168.   Bitte anschließend IsamOk beachten.
  169.   Fehlermöglichkeiten wie bei SearchKey.
  170. }
  171.  
  172. procedure RefSuchen (var IFBPtr:IsamFileBlockPtr;Key:integer;
  173.                      var Userdatref:Longint;var Userkey:IsamKeyStr;
  174.                      var Found:boolean);
  175. {Sucht einen Schlüssel mit Referenz.
  176.  
  177.   IFBPtr  : Dateivariable
  178.   Key     : Schlüsselnummer
  179.   UserdatRef : Datensatznummer des zu suchenden Schlüssels
  180.   UserKey : zu suchender Schlüssel
  181.   Found   : TRUE:  gewünschter Schlüssel wurde gefunden.
  182.             FALSE: gewünschter Schlüssel wurde nicht gefunden, weil
  183.               IsamOK=TRUE:  er nicht existiert. Userkey enthält den nächsten
  184.                             größeren Schlüssel.
  185.               IsamOK=FALSE: der Zugriff wegen eines Fehlers nicht durchge-
  186.                             führt werden konnte.
  187.  
  188.   Bitte anschließend IsamOk beachten.
  189. }
  190.  
  191. procedure SatzEinlesen(var IFBPtr:IsamFileBlockPtr;Key:integer;
  192.                        var Satz,Dup;Keys:KeyProc;var Klar:boolean);
  193. {Liest einen Satz ein. Funktionsweise: Die Felder der Variablen "Satz", die
  194.  bekannt sind, müssen vor Aufruf besetzt werden (z.B. das Kundennummernfeld,
  195.  wenn nach einer Kundennummer gesucht werden soll). Diese Prozedur sucht
  196.  dann den passenden Satz und liest ihn ein.
  197.  
  198.    IFBPtr  : Dateivariable
  199.    Key     : Nummer das Schlüssels, anhanddessen gesucht werden soll
  200.    Satz    : s.o., erhält hinterher den kompletten Satz
  201.    Dup     : s. SatzLesen
  202.    Keys    : s. SatzAendern, type KeyProc
  203.    Klar    : TRUE, wenn der Satz gefunden und ordnungsgemäß gelesen wurde
  204.  
  205.    Bitte anschließend IsamOk beachten.
  206.    Fehlermöglichkeiten wie bei SearchKey, GetNetRec.
  207.  }
  208.  
  209. const
  210.   FindFirst  = 0;
  211.   FindLast   = 1;
  212.   FindNext   = 2;
  213.   FindPrev   = 3;
  214.   FindALL    = 4;
  215.  
  216. procedure NachbarKey(var IFBPtr:IsamFileBlockPtr;Key:integer;
  217.                      var UserDatRef:longint;var UserKey:IsamKeyStr;
  218.                      SuchArt:byte);
  219. {Sucht den nächsten bzw. vorigen Schlüssel.
  220.  
  221.   IFBPtr  : Dateivariable
  222.   Key     : Schlüsselnummer
  223.   UserDatRef : erhält die Datensatznummer des gefundenen Schlüssels
  224.   UserKey : erhält den gefundenen Schlüssel
  225.   SuchArt : 0=der erste Schlüssel wird gesucht
  226.             1=der letzte Schlüssel wird gesucht
  227.             2=der nächste Schlüssel wird gesucht
  228.             3=der vorige   Schlüssel wird gesucht
  229.             4=der erste übereinstimmende Schlüssel (FINDKEY) wird gesucht
  230.  
  231.   Bitte anschließend IsamOk beachten.
  232.   Fehlermöglichkeiten wie bei NextKey, PrevKey, ClearKey.
  233. }
  234.  
  235.  
  236. procedure DeleteAllRecs(var IFBPtr    : IsamFileBlockPtr;
  237.                             VonKey,
  238.                             BisKey    : IsamKeyStr;
  239.                             Key       : integer;
  240.                             Keys      : KeyProc);
  241.  
  242. {Löscht alle Datensätze, die im angegebenen Bereich von Schlüsseln liegen.
  243.  
  244.     IFBPtr  :  bezogener FileBlock
  245.     VonKey  :  kleinster Schlüssel, der gelöscht werden soll
  246.     BisKey  :  kleinster Schlüssel, der nicht mehr gelöscht werden soll
  247.                (also obere Grenze, bleibt selbst aber erhalten)
  248.     Key     :  Schlüsselnummer.
  249. }
  250. procedure LockFile(Var IFBPtr:IsamFileBlockPtr);
  251. procedure UnlockFile(var IFBPtr:IsamFileBlockPtr);
  252. {Achtung: Vor KeysAendern LOCKFILE!!!}
  253. procedure KeysAendern(var IFBPtr:IsamFileBlockPtr;var Quelle,Dup;
  254.           RefNr:longint;Keys:KeyProc;var OK:boolean);
  255.  
  256. const ErrorFile:String = '';
  257.  
  258. var
  259.   NetInUse   : boolean;
  260.  
  261. type
  262.   PrPrTyp   = procedure (s:String);
  263.  
  264. var
  265.   PrPr  : PrPrTyp;
  266.  
  267. const
  268.   IsamAntwort : word = 0;
  269.  
  270. implementation
  271.  
  272. var
  273.   RepCnt  : byte;
  274.  
  275. const
  276.   LastFB  : IsamFileBlockPtr = nil;
  277.   FlushDelay : longint = 900; {Sek.}
  278.  
  279. const
  280.   DelTime     = 100;
  281.   NrOfReps    : byte = 3;
  282.  
  283. Function GetMess(Id: Integer): String;
  284. var S: String;
  285. begin
  286.   if Sprache = 1 then begin
  287.     Case Id of
  288.        1: S:= 'Record is locked, can┤t read.';
  289.        2: S:= 'Repeat ?';
  290.        3: S:= 'File was opened in SAVE-Mode';
  291.        4: S:= 'Can`t open, file is locked';
  292.        5: S:= 'File couldn┤t be closed because of filelock';
  293.        6: S:= 'Press ENTER to try again.';
  294.        7: S:= 'Can`t write, file is locked';
  295.        8: S:= 'Lock error ';
  296.        9: S:= 'Can`t unlock, file is locked by other user.';
  297.       10: S:= 'BTDELETEKEY-Error: ';
  298.       11: S:= 'BTADDKEY-Error: ';
  299.       12: S:= 'LOCKIT-Error: ';
  300.       13: S:= 'RECSIZE-Error: ';
  301.       14: S:= '';
  302.       15: S:= 'GETREC-Error: ';
  303.       16: S:= 'Record change:';
  304.       17: S:= 'keys couldn┤t be changed correctly !';
  305.       18: S:= 'BTPUTREC-Error ';
  306.       19: S:= 'Record change:';
  307.       20: S:= 'Record was changed in the meantime';
  308.       21: S:= 'Attention! IsamError ';
  309.       22: S:= 'Can┤t search, file is locked.';
  310.       23: S:= 'Can┤t skip, file is locked.';
  311.       24: S:= 'reached end of file';
  312.       25: S:= 'IsamError-Message ';
  313.       26: S:= '';
  314.       27: S:= 'CLEARKEY-Error, file is locked.';
  315.       28: S:= 'Can┤t READLOCK, file is locked by other user.';
  316.       29: S:= 'Can┤t LOCK, file is locked by other user.';
  317.       30: S:= 'Can┤t READUNLOCK, file is locked by other user.';
  318.       31: S:= 'That is impossible: InitCount = ';
  319.       else S:= '';
  320.     end;
  321.   end
  322.   else begin
  323.     Case Id of
  324.        1: S:= 'Lesen z.Zt. nicht m÷glich wegen Locking';
  325.        2: S:= 'Wiederholen ?';
  326.        3: S:= 'Datei wurde im SAVEMODUS ge÷ffnet';
  327.        4: S:= 'Zugriff z.Zt. nicht m÷glich wegne Locking';
  328.        5: S:= 'Datei konnte nicht geschlossen werden wegen Locking.';
  329.        6: S:= 'Bitte <RETURN> fⁿr einen neuen Versuch.' ;
  330.        7: S:= 'Schreiben z.Zt. nicht m÷glich wegen Locking.';
  331.        8: S:= 'LockFehler ';
  332.        9: S:= 'UNLOCK z.Zt. nicht m÷glich wegen Locking.';
  333.       10: S:= 'FEHLER BEI BTDELETEKEY: ';
  334.       11: S:= 'FEHLER BEI BTADDKEY: ';
  335.       12: S:= 'FEHLER BEI LOCKIT: ';
  336.       13: S:= 'FEHLER BEI RECSIZE: ';
  337.       14: S:= '';
  338.       15: S:= 'FEHLER BEI GETREC: ';
  339.       16: S:= 'SatzΣndern:';
  340.       17: S:= 'Keys konnten nicht korrekt geΣndert werden!!';
  341.       18: S:= 'Fehler bei BTPUTREC ';
  342.       19: S:= 'SatzΣndern:';
  343.       20: S:= 'Satz wurde zwischenzeitlich von jemand geΣndert.';
  344.       21: S:= 'Achtung! IsamFehler ';
  345.       22: S:= 'Suche z.Zt nicht m÷glich wegen Locking.';
  346.       23: S:= 'BlΣttern z.Zt nicht m÷glich wegen Locking.';
  347.       24: S:= 'Dateiende erreicht';
  348.       25: S:= 'IsamAntwort Meldung';
  349.       26: S:= '';
  350.       27: S:= 'CLEARKEY z.Zt nicht m÷glich wegen Locking.';
  351.       28: S:= 'READLOCK z.Zt nicht m÷glich wegen Locking.';
  352.       29: S:= 'LOCK z.Zt nicht m÷glich wegen Locking.';
  353.       30: S:= 'READUNLOCK z.Zt nicht m÷glich wegen Locking.';
  354.       31: S:= 'Das kann nicht sein: InitCount =';
  355.       else S:= '';
  356.     end;
  357.   end;
  358.   Result:= S;
  359. end;
  360.  
  361. function Compare(var A,B;Count:word):boolean;inline
  362.  
  363. ($59/      {POP CX    (count)}
  364.  $8C/$DA/  {MOV DX,DS (Inhalt sichern)}
  365.  $5E/      {POP SI}
  366.  $1F/      {POP DS    (B)}
  367.  $5F/      {POP DI}
  368.  $07/      {POP ES}
  369.  $FC/      {CLD}
  370.  $B8/$00/$00/{MOV AX,0000}
  371.  $F3/$A6/  {REPZ CMPSB}
  372.  $75/$03/  {JNZ x}
  373.  $B8/$01/$00/{MOV AX,0001}
  374.  $8E/$DA   {x:MOV DS,DX}
  375. );
  376.  
  377.  
  378.  
  379. Procedure Delay(t: Integer);
  380. begin
  381. end;
  382.  
  383. procedure SatzLesen;
  384.  
  385.   label a;
  386.  
  387.   var
  388.     t   : char;
  389.  
  390.   begin
  391.     LastFB := IFBPtr;
  392. a:  RepCnt := NrOfReps;
  393.     repeat
  394.       dec(RepCnt);
  395.       BTGetRec(IFBPtr,RefNr,Ziel,false);
  396.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  397.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  398.     if BTIsamErrorClass=2 then begin
  399.       if JaNein(GetMess(1),GetMess(2))
  400.       then goto a;
  401.     end;
  402.     if IsamOk then move(Ziel,Dup,BTDatRecordSize(IFBPtr));
  403.   end;
  404.  
  405. procedure DateiOeffnen;
  406.  
  407.   label a;
  408.  
  409.   var
  410.     t   : char;
  411.     t2  : byte;
  412.  
  413.   begin
  414.  
  415. a:  RepCnt := NrOfReps;
  416.     repeat
  417.       if RepCnt <> NrOfReps then  waitwindow(intstr(NrOfReps-RepCnt+1)
  418.                                   +'. Versuch Datei÷ffnen'
  419.                                   +#13+'          von '
  420.                                   +Dezstr(NrOfReps)+' Versuchen','wegen Locking');
  421.       dec(RepCnt);
  422.       if MySave then Serrorwindow(GetMess(3),'');
  423.       BTOpenFileBlock(IFBPtr,Name,false,false,MySave,true);
  424.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  425.     CloseWait;
  426.     if BTIsamErrorClass=2 then
  427.     begin
  428.       if JaNein(GetMess(4),GetMess(2))
  429.       then goto a;
  430.     end;
  431.     if IsamOk then
  432.     begin
  433.       for t2 := 1 to IFBPtr^.NrOfKeys do BTSetSearchForSequential(IFBPtr,t2,true);
  434.       if BTDatRecordSize(IFBPtr)<>RSize then
  435.       begin
  436.         isamfehler := 24;
  437.         IsamOk := False;
  438.       end;
  439.       LastFB := IFBPtr;
  440.     end else begin
  441.       LastFB := nil;
  442.       ErrorFile := Name;
  443.       IsamOk := False;
  444.       IsamFehler := IsamError;
  445.     end;
  446.   end;
  447.  
  448.  
  449. procedure DateiSchliessen;
  450.  
  451.   label a;
  452.  
  453.   begin
  454.     LastFB := IFBPtr;
  455. a:  RepCnt := NrOfReps;
  456.     repeat
  457.       dec(RepCnt);
  458.       BTCloseFileBlock(IFBPtr);
  459.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  460.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  461.     if BTIsamErrorClass=2 then begin
  462.       ErrorWindow(GetMess(5)+  ZeroStrToStr(LastFB^.DatF.Name),GetMess(6));
  463.       goto a;
  464.     end;
  465.   end;
  466.  
  467.  
  468. procedure LockFile;
  469.  
  470.   label a;
  471.  
  472.   var
  473.     t : char;
  474.  
  475.   begin
  476.     LastFB := IFBPtr;
  477.     ISAMCLEAROK;
  478. a:  RepCnt := NrOfReps;
  479.     repeat
  480.       dec(RepCnt);
  481.       BTLockFileBlock(IFBPtr);
  482.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  483.     until (BTIsamErrorCLASS<>2) or (RepCnt=0);
  484.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  485.       if JaNein(GetMess(7),GetMess(2))
  486.       then goto a;
  487.     end;
  488.     IF BTIsamErrorClass <> 0 THEN ERRORWINDOW(GetMess(8),DEZSTR(ISAMERROR));
  489.   end;
  490.  
  491. procedure UNLockFile;
  492.  
  493.   label a;
  494.  
  495.   var
  496.     t : char;
  497.  
  498.   begin
  499.     LastFB := IFBPtr;
  500.     ISAMCLEAROK;
  501. a:  RepCnt := NrOfReps;
  502.     repeat
  503.       dec(RepCnt);
  504.       BTUNLockFileBlock(IFBPtr);
  505.     until (BTIsamErrorCLASS<>2) or (RepCnt=0);
  506.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  507.       if JaNein(GetMess(9),GetMess(2))
  508.       then goto a;
  509.     end;
  510.     IF BTIsamErrorClass <> 0 THEN ERRORWINDOW(GetMess(8),DEZSTR(ISAMERROR));
  511.   end;
  512.  
  513.  
  514. type
  515.   tLockArt = (LANoLock,LARdLock,LALock);
  516.  
  517. procedure LockIt(var IFBPtr:IsamFileBlockPtr;var LStore:tLockArt);
  518.   begin
  519.     if BTFileBlockIsReadLocked(IFBPtr) then begin
  520.       LStore := LARdLock;
  521.     end else if BTFileBlockIsLocked    (IFBPtr) then begin
  522.       LStore := LALock
  523.     end else LStore := LANoLock;
  524.     LockFile(IFBPtr);
  525.   end;
  526.  
  527. procedure UnlockIt(var IFBPtr:IsamFileBlockPtr;LStore:tLockArt);
  528.  
  529.   begin
  530.     {*********************************}
  531.     UnlockFile(IFBPtr);
  532.     EXIT;
  533.     {*********************************}
  534.     case LStore of
  535.       LANoLock : UnlockFile(IFBPtr);
  536.       LARdLock : BTReadLockFileBlock(IFBPtr);
  537.       LALock   : ;
  538.     end;
  539.   end;
  540.  
  541. procedure KeysAendern;
  542.  
  543.   var
  544.     ks1,
  545.     ks2     : String;
  546.     FehlNo,
  547.     KeyCnt  : word;
  548.     Status  : boolean;
  549.   Label FEHLER0,FEHLER1,FEHLER2,FEHLER3,FEHLER4;
  550.  
  551.   begin
  552.     LastFB := IFBPtr;
  553.     KeyCnt := 1;
  554.     ISAMCLEAROK;
  555.     while (KeyCnt<=IFBPtr^.NrOfKeys) and IsamOk do
  556.     begin
  557.       Ks1 := KEYS(Quelle,KeyCnt);
  558.       Ks2 := KEYS(DUP,KeyCnt);
  559.       Status := false;
  560.       if ks1<>Ks2 then begin
  561.    FEHLER0:
  562.         ISAMCLEAROK;
  563.         BTDeleteKey(IFBPtr,KeyCnt,RefNr,ks2);
  564.         IF NOT ISAMOK THEN IF JANEIN(GetMess(10)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER0;
  565.         if IsamOk then
  566.         begin
  567.           Status := true;
  568.    FEHLER1:
  569.           ISAMCLEAROK;
  570.           BTAddKey(IFBPtr,KeyCnt,RefNr,ks1);
  571.           IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER1;
  572.         end;
  573.       end;
  574.       if IsamOk then inc(KeyCnt);
  575.     end;
  576.  
  577.  
  578.     OK := IsamOk;
  579.     if not IsamOk then
  580.     begin
  581.       FehlNo := IsamError;
  582.       if Status then
  583.       BEGIN
  584.    FEHLER2:
  585.         ISAMCLEAROK;
  586.         BTAddKey(IFBPtr,KeyCnt,RefNr,ks2);
  587.         IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+'2'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER2;
  588.       END;
  589.       for KeyCnt := 1 to KeyCnt-1 do begin
  590.         Ks1 := KEYS(Quelle,KeyCnt);
  591.         Ks2 := KEYS(DUP,KeyCnt);
  592.         Status := false;
  593.         if ks1<>Ks2 then
  594.         begin
  595.             ISAMCLEAROK;
  596.    FEHLER3:
  597.             BTDeleteKey(IFBPtr,KeyCnt,RefNr,ks1);
  598.             IF NOT ISAMOK THEN IF JANEIN(GetMess(10)+'2'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER3;
  599.    FEHLER4:
  600.             ISAMCLEAROK;
  601.             BTAddKey(IFBPtr,KeyCnt,RefNr,ks2);
  602.             IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+'3'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER4;
  603.         end;
  604.       end;
  605.       if IsamOk then IsamError := FehlNo;
  606.       if IsamError=10230 then
  607.       begin {Schlⁿssel doppelt}
  608.         IsamError := 0;
  609.         IsamOk     := true;
  610.       end else IsamOk := false;
  611.     end;
  612.   end;
  613.  
  614. procedure SatzAendern;
  615.  
  616.   label
  617.     Hilfe;
  618.  
  619.   var
  620.     tds        : pointer;
  621.     rs         : longint;
  622.     KeyCnt     : word;
  623.     WarLocked  : tLockArt;
  624.     LABEL FEHLER0,FEHLER1,FEHLER2,FEHLER3,FEHLER4;
  625.  
  626.   begin
  627.     OK := false;
  628.  
  629.   FEHLER0:
  630.     ISAMCLEAROK;
  631.     LockIt(IFBPtr,WarLocked);
  632.     IF NOT ISAMOK THEN IF JANEIN(GetMess(12)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER0;
  633.     if IsamOk then
  634.     begin
  635.   FEHLER1:
  636.       ISAMCLEAROK;
  637.       rs := BTDatRecordSize(IFBPtr);
  638.       IF NOT ISAMOK THEN IF JANEIN(GetMess(13)+ INTSTR(ISAMERROR),'RS: '+DEZSTR(RS)+GetMess(2)) THEN GOTO FEHLER1;
  639.       getmem(tds,rs);
  640.   FEHLER2:
  641.       ISAMCLEAROK;
  642.       BTGetRec (IFBPtr,RefNr,tds^,TRUE); {HIER WAR FALSE!!!
  643.                                           bei einem Lock wird nun trotzdem
  644.                                           gelesen}
  645.       IF NOT ISAMOK THEN IF JANEIN(GetMess(15)+INTSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER2;
  646.       if not IsamOk then goto Hilfe;
  647.       if compare (tds^,Dup,rs) then
  648.       begin
  649.         KeysAendern(IFBPtr,Quelle,Dup,RefNr,Keys,OK);
  650.         if not OK then errorwindow ('SatzÄndern:',
  651.         'Keys konnten nicht korrekt geändert werden!!');
  652.         OK := true;
  653.   FEHLER3:
  654.         ISAMCLEAROK;
  655.         BTPutRec(IFBPtr,RefNr,Quelle,false);
  656.         IF NOT ISAMOK THEN IF JANEIN(GetMess(18)+ DEZSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER3;
  657.       end else errorwindow(GetMess(19),GetMess(20));
  658.   Hilfe:
  659.       IF NOT ISAMOK THEN  ERRORWINDOW('WSNR  : ',
  660.                                       'ERROR: '+INTSTR(IsamError));
  661.       KeyCnt := IsamError;
  662.       freemem(tds,rs);
  663.   FEHLER4:
  664.       ISAMCLEAROK;
  665.       UnlockIt(IFBPtr,WarLocked);
  666.       IF NOT ISAMOK THEN IF JANEIN(GetMess(12)+ INTSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER4;
  667.       if IsamOk then
  668.       begin
  669.         IsamOk := KeyCnt =0;
  670.         IsamError := KeyCnt;
  671.       end;
  672.       IF ISAMERROR = 10070 THEN ERRORWINDOW('?????','');
  673.     end;
  674.   end;
  675.  
  676.  
  677.  
  678. procedure SatzAnlegen;
  679.  
  680.   var
  681.     StIF,
  682.     KeyCnt    : word;
  683.     RefNr     : longint;
  684.     WarLocked : tLockArt;
  685.     schluessel: isamkeySTR;
  686.  
  687.   begin
  688.     LockIt(IFBPtr,WarLocked);
  689.     if IsamOk then
  690.     begin
  691.       BTAddRec(IFBPtr,RefNr,Quelle);
  692.       SatzNoAngel := RefNr;
  693.       if IsamOk then
  694.       begin
  695.         KeyCnt := 1;
  696.         while (KeyCnt<=IFBPtr^.NrOfKeys) and IsamOk do
  697.         begin
  698.            BTAddKey(IFBPtr,KeyCnt,RefNr,KEYS(Quelle,KeyCnt));
  699.            inc(KeyCnt);
  700.         end;
  701.         if not IsamOk then
  702.         begin
  703.           StIF := IsamError;
  704.           dec(keycnt);
  705.           while keycnt > 1 do
  706.           begin
  707.             dec(keycnt);
  708.             BTDELETEKEY(IFBptr,keycnt,refnr,keys(quelle,keycnt));
  709.           end;
  710.  
  711.           BTDeleteRec(IFBPtr,Refnr);
  712.           IsamError := StIF;
  713.           IsamOK := false;
  714.         end;
  715.       end;
  716.       KeyCnt := IsamError;
  717.       UnlockIt(IFBPtr,WarLocked);
  718.       if IsamOk then
  719.       begin
  720.         IsamOk := KeyCnt =0;
  721.         IsamError := KeyCnt;
  722.       end;
  723.     end;
  724.   end;
  725.  
  726.  
  727.  
  728. procedure Satzloeschen;
  729. label hilfe;
  730.  
  731.   var
  732.     tds       : pointer;
  733.     rs        : longint;
  734.     KeyCnt    : word;
  735.     WarLocked : tLockArt;
  736.  
  737.   begin
  738.     OK := false;
  739.     LockIt(IFBPtr,WarLocked);
  740.     if IsamOk then begin
  741.       rs := BTDatRecordSize(IFBPtr);
  742.       getmem(tds,rs);
  743.       BTGetRec (IFBPtr,RefNr,tds^,false);
  744.       if not IsamOk then goto Hilfe;
  745.       if compare (tds^,Dup,rs) then begin
  746.         for KeyCnt := 1 to IFBPtr^.NrOfKeys do begin
  747.           BTDeleteKey(IFBPtr,KeyCnt,RefNr,Keys(Dup,KeyCnt));
  748.         end;
  749.         BTDeleteRec(IFBPtr,RefNr);
  750.         OK := true;
  751.       end;
  752. Hilfe:
  753.       KeyCnt := IsamError;
  754.       freemem(tds,rs);
  755.       UnlockIt(IFBPtr,WarLocked);
  756.       if IsamOk then begin
  757.         IsamOk := KeyCnt =0;
  758.         IsamError := KeyCnt;
  759.       end;
  760.     end;
  761.   end;
  762.  
  763. procedure KeySuchen;
  764.  
  765.   label a;
  766.  
  767.   var
  768.     t   : char;
  769.     tk  : IsamKeyStr;
  770.  
  771.   begin
  772.     LastFB := IFBPtr;
  773. a:  RepCnt := NrOfReps;
  774.     tk := UserKey;
  775.     repeat
  776.       dec(RepCnt);
  777.       BTSearchKey(IFBPtr,Key,UserDatRef,tk);
  778.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  779.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  780.     if BTIsamErrorClass=2 then begin
  781.       if JaNein(GetMess(22),GetMess(2))
  782.       then goto a;
  783.     end;
  784.     if IsamOk then Found := UserKey=tk else Found := false;
  785.     UserKey := tk;
  786.   end;
  787.  
  788. procedure RefSuchen;
  789.  
  790.   label a;
  791.  
  792.   var
  793.     t   : char;
  794.     tk  : IsamKeyStr;
  795.     tr  : longint;
  796.  
  797.   begin
  798.     LastFB := IFBPtr;
  799. a:  RepCnt := NrOfReps;
  800.     tk := UserKey;
  801.     tr := UserDatRef;
  802.     repeat
  803.       dec(RepCnt);
  804.       BTFindKeyAndRef(IFBPtr,Key,tr,tk,+1);
  805.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  806.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  807.     if BTIsamErrorClass=2 then begin
  808.       if JaNein(GetMess(22),GetMess(2))
  809.       then goto a;
  810.     end;
  811.     if IsamOk then Found := (UserKey=tk) and (UserDatRef=tr) else Found := false;
  812.     UserKey := tk;
  813.     UserDatRef := tr;
  814.   end;
  815.  
  816. procedure SatzEinlesen;
  817.  
  818.   var
  819.     Ref : longint;
  820.     x   : IsamKeyStr;
  821.  
  822.   begin
  823.     LastFB := IFBPtr;
  824.     x := Keys(Satz,KEY);
  825.     KeySuchen(IFBPtr,Key,Ref,x,Klar);
  826.     if Klar then SatzLesen (IFBPtr,Ref,Satz,Dup);
  827.     klar := Klar and IsamOK;
  828.   end;
  829.  
  830. procedure NachbarKey;
  831.  
  832.   label a;
  833.  
  834.   var
  835.     t   : char;
  836.     uk  : IsamKeyStr;
  837.     FOUND:BOOLEAN;
  838.  
  839.   begin
  840.     LastFB := IFBPtr;
  841.  
  842. a:  RepCnt := NrOfReps;
  843.     uk := USERKEY;
  844.     ISAMCLEAROK;
  845.     REPEAT
  846.       dec (RepCnt);
  847.       if Suchart=4 then
  848.       BEGIN
  849.         KeySuchen(IFBPtr,Key,UserDatRef,USERKEY,FOUND);
  850.         EXIT;
  851.       END;
  852.       if SuchArt<2 then BTClearKey(IFBPtr,Key) else IsamOk := true;
  853.       if IsamOK then if odd(SuchArt)
  854.       then BTPrevKey(IFBPtr,Key,UserDatRef,uk)
  855.       else BTNextKey(IFBPtr,Key,UserDatRef,uk);
  856.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  857.     UNTIL (BTISAMERRORCLASS<> 2) OR (RepCnt = 0);
  858.     if RepCnt=0 then begin
  859.       if JaNein(GetMess(23),GetMess(2))
  860.       then goto a;
  861.     end;
  862.     if IsamOK then UserKey := uk;
  863.   end;
  864.  
  865.  
  866.  
  867. function IA;
  868.  
  869.   begin
  870.     IA := (IsamAntwort <>0);
  871.     IsamAntwort := 0;
  872.   end;
  873.  
  874. var Klasse : byte;
  875. {   Codes v. IsamErrorClass:
  876.   0 : kein Fehler;
  877.   1 : Dialog-Meldung;
  878.   2 : Locking-Fehler (kann nur durch eine Netz-Operation erfolgen);
  879.   3 : Operation im Save-Modus nicht ausgeführt;
  880.   4 : schwerer Fehler (Abbruch empfohlen);
  881.   99: unbekannter Fehler;}
  882.  
  883.  
  884.  
  885. procedure DIEE;
  886. VAR PROT  : TEXT;
  887.     DUMMY,D,Z : LONGINT;
  888.   begin
  889.     if IsamAntwort<>0 then
  890.     if (Isamantwort = 10250) or (IsamAntwort = 10260)
  891.     then SErrorWindow(GetMess(24),'') else
  892.     if IsamAntwort<>0 then if Isamantwort <> 10210 then SErrorWindow(GetMess(25) ,IntStr(IsamAntwort));
  893.     IsamAntwort := 0;
  894.     if not IsamOk then begin
  895.     case IsamError of
  896.         9900,
  897.         9903,
  898.         10410 : Klasse := 4;
  899.         else  Klasse := BTIsamErrorClass;
  900.      end;
  901.       case Klasse of
  902.         3,4 :
  903.         begin
  904.           GetSysZeit(D,Z);
  905.           if LastFB<>nil then ErrorFile := ZeroStrToStr(LastFB^.DatF.Name);
  906.           ERRORWINDOW(GetMess(21)+INTSTR(IsamError)+' / WS: '{+DEZSTR(ISAMWSNR)}+
  907.                       ' / '+ERRORFILE,'');
  908.          assign (Prot,'C:\EXITPROT.TXT');
  909. {$I-}
  910.          append(prot);
  911. {$I+}
  912.         dummy := ioresult;
  913.         If dummy <> 0 then rewrite(Prot);
  914.         writeln (Prot,DATESTR(D),' ',TimeStr(Z),
  915.         ' ISAMERROR '+INTSTR(IsamError)+' / '+ERRORFILE);
  916.          CLOSE(PROT);
  917.         end;
  918.         1 : IsamAntwort := IsamError; {Dialog-Meldung, nicht weiter beachten}
  919.  
  920.         2 : BEGIN
  921.               if LastFB<>nil then ErrorFile := ZeroStrToStr(LastFB^.DatF.Name);
  922.                ErrorWindow('LOCK ERROR/'{+DEZSTR(ISAMWSNR)}+ '/'+VERSIONSTR+'/'+INTSTR(IsamError)+
  923.               '/'+ERRORFILE,'');
  924.               IsamAntwort := IsamError;
  925.             END;
  926.  
  927.         0 : BEGIN
  928.               IsamAntwort := IsamError;
  929.             END;
  930.  
  931.       end; {of CASE}
  932.     end;
  933.     LastFB := nil;
  934.   end;
  935.  
  936. Procedure die;
  937. Begin
  938.   DIEE;
  939. end;
  940.  
  941.  
  942. var
  943.   GlobFuncBuildKey  : KeyProc;
  944.  
  945. function MyBuildKey(var DatS;KeyNr:Integer):IsamKeyStr;
  946.  
  947.   begin
  948.     MyBuildKey := GlobFuncBuildKey(DatS,KeyNr);
  949.   end;
  950.  
  951.  
  952. procedure DeleteAllRecs(var IFBPtr    : IsamFileBlockPtr;
  953.                             VonKey,
  954.                             BisKey    : IsamKeyStr;
  955.                             Key       : integer;
  956.                             Keys      : KeyProc);
  957.  
  958.   var
  959.     WarLocked  : tLockArt;
  960.     rs         : word;
  961.     Ref        : longint;
  962.     fnd        : boolean;
  963.     tds        : pointer;
  964.     AktKey     : IsamKeyStr;
  965.  
  966.   begin
  967.     LockIt(IFBPtr,WarLocked);
  968.     DIEE;
  969.     rs := BTDatRecordSize(IFBPtr);
  970.     getmem(tds,rs);
  971.     Ref := 0;
  972.     AktKey := VonKey;
  973.     KeySuchen(IFBPtr,Key,Ref,AktKey,fnd);
  974.     DIEE;
  975.     while (AktKey<BisKey) and not IA do begin
  976.       SatzLesen(IFBPtr,Ref,tds^,tds^);
  977.       DIEE;
  978.       SatzLoeschen(IFBPtr,Ref,tds^,Keys,fnd);
  979.       DIEE;
  980.       KeySuchen(IFBPtr,Key,Ref,AktKey,fnd);
  981.       DIEE;
  982.     end;
  983.     freemem(tds,rs);
  984.     UnLockIt(IFBPtr,WarLocked);
  985.   end;
  986.  
  987. function NotFound;
  988.  
  989.   begin
  990.     NotFound := IA and (IsamError=10200);
  991.   end;
  992.  
  993. Procedure ClearKey;
  994. label a;
  995. var
  996.   t   : char;
  997.   tk  : IsamKeyStr;
  998. BEGIN
  999.   LastFB := IFBPtr;
  1000. a:RepCnt := NrOfReps;
  1001.   repeat
  1002.     dec(RepCnt);
  1003.     BTCLEARKEY(IfbPtr,KEY);
  1004.     IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1005.   until (BTIsamErrorClass<>2) or (RepCnt=0);
  1006.   if BTIsamErrorClass=2 then
  1007.   begin
  1008.      if JaNein(GetMess(27),GetMess(2))
  1009.      then goto a;
  1010.    end;
  1011.  end;
  1012.  
  1013.  
  1014. Procedure READLOCK;
  1015. label a;
  1016. var
  1017.   t   : char;
  1018.   tk  : IsamKeyStr;
  1019. BEGIN
  1020.     LastFB := IFBPtr;
  1021. a:  RepCnt := NrOfReps;
  1022.     repeat
  1023.       dec(RepCnt);
  1024.       BTREADLOCKFILEBLOCK(IfbPtr);
  1025.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1026.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1027.     if BTIsamErrorClass=2 then begin
  1028.       if JaNein(GetMess(28),GetMess(2))
  1029.      then goto a;
  1030.     end;
  1031.   end;
  1032.  
  1033. Procedure LOCK;
  1034. label a;
  1035. var
  1036.   t   : char;
  1037.   tk  : IsamKeyStr;
  1038. BEGIN
  1039.     LastFB := IFBPtr;
  1040. a:  RepCnt := NrOfReps;
  1041.     repeat
  1042.       dec(RepCnt);
  1043.       BTLOCKFILEBLOCK(IfbPtr);
  1044.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1045.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1046.     if BTIsamErrorClass=2 then begin
  1047.       if JaNein(GetMess(29),GetMess(2))
  1048.      then goto a;
  1049.     end;
  1050.   end;
  1051.  
  1052.  
  1053.  
  1054.  
  1055. Procedure UNLOCK;
  1056. label a;
  1057. var
  1058.   t   : char;
  1059.   tk  : IsamKeyStr;
  1060. BEGIN
  1061.     LastFB := IFBPtr;
  1062. a:  RepCnt := NrOfReps;
  1063.     repeat
  1064.       dec(RepCnt);
  1065.       BTUNLOCKFILEBLOCK(IfbPtr);
  1066.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1067.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  1068.       if JaNein(GetMess(30),GetMess(2))
  1069.      then goto a;
  1070.     end;
  1071.   end;
  1072.  
  1073.  
  1074. Function INITIsam(Netz:NetSupportType) : Boolean;
  1075. Var
  1076.   b : Boolean;
  1077. BEGIN
  1078.   if InitCount < 1 then begin
  1079.     b := False;
  1080.     BTinitisam(Netz,30000+MINIMIZEUSEOFNORMALHEAP,0);
  1081.     Diee;
  1082.     If Isamok then b := True;
  1083.     INITIsam := b;
  1084.     Inc(InitCount);
  1085.   end else Inc(InitCount);
  1086. END;
  1087.  
  1088.  
  1089. PROCEDURE EXITIsam;
  1090. BEGIN
  1091.   if InitCount < 0 then errorwindow(GetMess(31),'InitCount =' + intStr(InitCount));
  1092.   if InitCount < 2 then
  1093.   begin
  1094.     BTUNLOCKALLOPENFILEBLOCKS;
  1095.     BTCloseAllFileBlocks;
  1096.     BTExitIsam;
  1097.     Dec(InitCount);
  1098.   end else Dec(InitCount);
  1099. END;
  1100.  
  1101. begin
  1102.   MySave := False;
  1103.   InitCount := 0;
  1104. end.
  1105.  
  1106.